{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Captions;

interface

uses Classes, UIObjects, Viewport, Fonts, Fills, Canvas, XMLHelper;

{$IFDEF DESIGNER}
const
  // Property categories and hints for designer
  CAT_CAPTION = 'Caption';
  HINT_FONT = 'specifies the name of a font item to use for the caption';
  HINT_ALIGN = 'determines the horizontal text alignment for the caption';
  HINT_FILL = 'specifies the name of a fill item to use for the background';
  HINT_WORDWRAP = 'controls whether text will be wrapped to fit in the available space';
  HINT_SCROLL = 'controls whether text will be automatically scrolled';
  HINT_DIRECTION = 'controls text scrolling direction for the caption';
  HINT_WIDTH = 'specifies width for the caption';
  HINT_HEIGHT = 'specifies height for the caption';
{$ENDIF}

type
  TAHMCaptionDirection = (cdHorizontal, cdVertical);

  TAHMCaption = class(TAHMUIDisplayObject)
  private
    FFont: TAHMFont;
    FAlign: TAHMTextAlign;
    FFill: TAHMAbstractFill;
    FWordWrap: Boolean;
    FScroll: Boolean;
    FDirection: TAHMCaptionDirection;
  protected
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    procedure RenderCustomFont(Control: TObject; CustomFont: TAHMFont); overload;
    procedure RenderCustomFont(Control: TObject; CustomFont: TAHMFont; CustomText: String;
                               iX, iY, iWidth, iHeight: Single; Clip: Boolean = False); overload;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single); override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Font: TAHMFont read FFont write FFont;
    property Align: TAHMTextAlign read FAlign write FAlign;
    property Fill: TAHMAbstractFill read FFill write FFill;
    property WordWrap: Boolean read FWordWrap write FWordWrap;
    property Scroll: Boolean read FScroll write FScroll;
    property Direction: TAHMCaptionDirection read FDirection write FDirection;
    // Publish inherited properties
    property VirtualWidth;
    property VirtualHeight;
  end;

  TAHMCaptionList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddCaption(const InheritFrom, NewName: String): TAHMCaption;
    function GetCaption(const Name: String): TAHMCaption;
    procedure PopulateDefaultObjects; override;
  end;


implementation

uses SysUtils, ApplicationManager, TagNames, XMLTags, ErrorCodes,
     CaptionedObject, BaseControls, UIControls, Scrolling, Colour, AHMTypes;

constructor TAHMCaptionList.Create;
begin
  inherited Create;

  XMLTagName := TAG_CAPTIONS;
  ChildClass := TAHMCaption;
end;

function TAHMCaptionList.AddCaption(const InheritFrom, NewName: String): TAHMCaption;
begin
  Result := TAHMCaption(Inherit(InheritFrom, NewName));
end;

function TAHMCaptionList.GetCaption(const Name: String): TAHMCaption;
begin
  Result := TAHMCaption(GetObject(Name));
end;

procedure TAHMCaptionList.PopulateDefaultObjects;
begin
  with ApplicationManagerInstance, DefaultObject as TAHMCaption do
  begin
    VirtualWidth := DEFAULT_CTRL_WIDTH;
    VirtualHeight := DEFAULT_CTRL_HEIGHT;
    Align := taLeft;
    Font := TAHMFont(ThemeManager.ThemeObjects[otFonts].DefaultObject);
  end;
end;

//----------------------------------------------------------------------------//
constructor TAHMCaption.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_CAPTION;
  ObjectType := otCaptions;
  ImageIndex := Ord(otCaptions);

{$IFDEF DESIGNER}
  // Render preview using a caption control so that scrolling is supported
  PreviewControlClass := TAHMCaptionControl;
  PreviewDisplayText := GREEKING_TEXT;
{$ENDIF}
end;

procedure TAHMCaption.ClearProperties;
begin
  inherited;

  // Clear custom caption properties
  FFont := nil;
  FFill := nil;
  FWordWrap := False;
  FScroll := False;
  FDirection := cdHorizontal;
  FAlign := taUnknown;
end;

procedure TAHMCaption.RenderCustomFont(Control: TObject; CustomFont: TAHMFont);
var
  iX, iY, iWidth, iHeight: Single;
begin
  // We might get passed a button or a caption
  with Control as TAHMControl do
  begin
    // Adjust text position for interactive controls
    if Control is TAHMInteractiveControl then
    begin
      iX := XPos + TAHMUICaptionedDisplayObject(DefaultStyle).CaptionX;
      iY := YPos + TAHMUICaptionedDisplayObject(DefaultStyle).CaptionY;
    end
    else
    begin
      iX := XPos;
      iY := YPos;
    end;

    // If size not set then use full viewport
    iWidth := Self.Width; iHeight := Self.Height;
    if iWidth = 0 then iWidth := Viewport.Width - iX;
    if iHeight = 0 then iHeight := Viewport.Height - iY;

    // Defer rendering to method below now we know dimensions
    RenderCustomFont(Control, CustomFont, DisplayText, iX, iY, iWidth, iHeight);
  end;
end;

procedure TAHMCaption.RenderCustomFont(Control: TObject; CustomFont: TAHMFont; CustomText: String;
                                       iX, iY, iWidth, iHeight: Single; Clip: Boolean);
var
  Shade: TAHMCanvasShade;
  CanvasFont: TAHMCanvasFont;
  CaptionScroll: TAHMAbstractScroller;
begin
  // We might get passed a button or a caption
  with Control as TAHMControl do
  begin
    // Determine appropriate canvas font to use
    if Assigned(CustomFont) then CanvasFont := CustomFont.Font
    else if Assigned(FFont) then CanvasFont := FFont.Font
    else Exit;

    // Do we want to enable scrolling?
    if FScroll then CaptionScroll := Scroller
               else CaptionScroll := nil;

    // If scroller assigned then set horizontal/vertical direction
    if Assigned(CaptionScroll) then
      CaptionScroll.Vertical := (Direction = cdVertical);

    with Viewport do
    begin
      // Use fill shading if populated, otherwise use gamma
      if FFill <> nil then Shade := FFill.Shade else Shade := nil;

      // Use clipping version if required
      if Clip then
        Canvas.TextRect(CanvasRect(iX, iY, iWidth, iHeight), ClipRect,
                        CanvasFont, CustomText, FAlign, FWordWrap,
                        CaptionScroll, Shade, Gamma, XScale, YScale,
                        HorizontalFlip, VerticalFlip)
      else
        Canvas.TextRect(CanvasRect(iX, iY, iWidth, iHeight), CanvasFont,
                        CustomText, FAlign, FWordWrap, CaptionScroll, Shade,
                        Gamma, XScale, YScale, HorizontalFlip, VerticalFlip);
    end;
  end;
end;

procedure TAHMCaption.Render(Control: TObject; iX, iY, iWidth, iHeight: Single);
begin
  // Defer this to above method, but without a custom font
  RenderCustomFont(Control, nil);
end;

procedure TAHMCaption.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      Font := FontList.GetFont(DEFAULT_OBJECT_NAME);
      Align := taLeft;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
    end;
{$ENDIF}
end;

procedure TAHMCaption.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMCaption do
  begin
    Self.Font := Font;
    Self.Align := Align;
    Self.Fill := Fill;
    Self.WordWrap := WordWrap;
    Self.Scroll := Scroll;
    Self.Direction := Direction;
  end;
end;

procedure TAHMCaption.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMCaption;
  sWork: String;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMCaption(ObjectToCompare);

  // Only populate attributes that differ from our ancestor
  if (FFont <> nil) and (FFont <> oAncs.Font) then
      Lines.Add(TABS[3] + FFont.XMLReference);
  if (FFill <> nil) and (FFill <> oAncs.Fill) then
    Lines.Add(TABS[3] + FFill.XMLReference);

  // Do we need to store text alignment?
  if (FAlign <> taUnknown) and (FAlign <> oAncs.Align) then
  begin
    sWork := TGB+TAG_ALIGN+SPC+ATTR_TEXT+ATB;
    if FAlign = taLeft then sWork := sWork + ATTR_VAL_LEFT
    else if FAlign = taRight then sWork := sWork + ATTR_VAL_RIGHT
    else sWork := sWork + ATTR_VAL_CENTER;
    Lines.Add(TABS[3] + sWork + ATE);
  end;

  // Do we need to store display flags
  if (FWordWrap and (FWordWrap <> oAncs.WordWrap)) or
     (FScroll and (FScroll <> oAncs.Scroll)) or
     ((FDirection <> cdHorizontal) and (FDirection <> oAncs.Direction)) then
  begin
    sWork := TGB+TAG_DISPLAY+SPC+ATTR_WORDWRAP+ATB + Bool2Str(FWordWrap);
    sWork := sWork + ATN+ATTR_SCROLL+ATB + Bool2Str(FScroll);
    sWork := sWork + ATN+ATTR_VERTICAL+ATB + Bool2Str(FDirection = cdVertical);
    Lines.Add(TABS[3] + sWork + ATE);
  end;

  // Do we need to store size?
  if ((VirtualWidth <> 0) and (VirtualWidth <> oAncs.VirtualWidth)) or
     ((VirtualHeight <> 0) and (VirtualHeight <> oAncs.VirtualHeight)) then
    Lines.Add(TABS[3] + TGB+TAG_SIZE+TGC+ IntToStr(VirtualWidth) + ',' +
              IntToStr(VirtualHeight) + TGE+TAG_SIZE+TGC);
end;

procedure TAHMCaption.ParseFromXML(XML: TAHMXMLHelper);
var
  sFont, sAlign, sFill, sWrap, sScroll, sVertical: String;
  iW, iH: Integer;
  CaptionNode, PropsNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  CaptionNode := XML.CurrentNode;
  PropsNode := nil;

  // All caption elements are optional, so see what we have
  while XML.NextElement(CaptionNode, PropsNode) do
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      if XML.CurrentElement = TAG_FONT then
      begin
        sFont := XML.GetAttribute(ATTR_NAME);
        if sFont <> '' then Font := FontList.GetFont(sFont);
      end
      else if (XML.CurrentElement = TAG_FILL) or
              (XML.CurrentElement = TAG_GRADEDFILL) or
              (XML.CurrentElement = TAG_LINEARFILL) then
      begin
        sFill := XML.GetAttribute(ATTR_NAME);
        if sFill <> '' then Fill := FillList.GetFill(sFill);
      end
      else if XML.CurrentElement = TAG_ALIGN then
      begin
        // Determine the text alignment
        sAlign := XML.GetAttribute(ATTR_TEXT);
        if sAlign = ATTR_VAL_LEFT then Align := taLeft
        else if sAlign = ATTR_VAL_RIGHT then Align := taRight
        else if sAlign = ATTR_VAL_CENTER then Align := taCenter;
      end
      else if XML.CurrentElement = TAG_DISPLAY then
      begin
        // Get text display attributes
        sWrap := XML.GetAttribute(ATTR_WORDWRAP);
        sScroll := XML.GetAttribute(ATTR_SCROLL);
        sVertical := XML.GetAttribute(ATTR_VERTICAL);
        if sWrap <> '' then WordWrap := Str2Bool(sWrap);
        if sScroll <> '' then Scroll := Str2Bool(sScroll);
        if sVertical <> '' then
          if Str2Bool(sVertical) then Direction := cdVertical;
      end
      else if (XML.CurrentElement = TAG_SIZE) then
      begin
        // Get the text size
        if not XML.GetCoordsValue(iW, iH) then
          LogParsingError(THM_PRS_VIS_MALFORMED_CA_SIZE_TAGS, Self);

        if iW <> 0 then VirtualWidth := iW;
        if iH <> 0 then VirtualHeight := iH;
      end;
    end;
end;

procedure TAHMCaption.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom caption properties
  Properties.Add('Font', 'Font', CAT_CAPTION, HINT_FONT);
  Properties.Add('Alignment', 'Align', CAT_CAPTION, HINT_ALIGN);
  Properties.Add('Fill', 'Fill', CAT_CAPTION, HINT_FILL);
  Properties.Add('Word Wrap', 'WordWrap', CAT_CAPTION, HINT_WORDWRAP);
  Properties.Add('Scrolling', 'Scroll', CAT_CAPTION, HINT_SCROLL);
  Properties.Add('Scroll Direction', 'Direction', CAT_CAPTION, HINT_DIRECTION);
  Properties.Add('Width', 'VirtualWidth', CAT_CAPTION, HINT_WIDTH);
  Properties.Add('Height', 'VirtualHeight', CAT_CAPTION, HINT_HEIGHT);
{$ENDIF}
end;

end.
